COMMENT ⊗   VALID 00002 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	 A ACWPRV PDLEN S%FIN2 S%TIMW IMPSRV DEVNAM DEVSER STATE GTIMER TTYLIN IMPDDB SYSTOP SYSREL DDBSAV CONFRM NUMBAD NUMCLR PDL CLRIMP LOOP CLRONE NXTIMP ALLDON OCTOUT OCTOU1 DECOUT DECOU1 YESNO CPOPJ1 CPOPJ YESNO1 YESNO2
C00010 ENDMK
C⊗;
;⊗ A ACWPRV PDLEN S%FIN2 S%TIMW IMPSRV DEVNAM DEVSER STATE GTIMER TTYLIN IMPDDB SYSTOP SYSREL DDBSAV CONFRM NUMBAD NUMCLR PDL CLRIMP LOOP CLRONE NXTIMP ALLDON OCTOUT OCTOU1 DECOUT DECOU1 YESNO CPOPJ1 CPOPJ YESNO1 YESNO2

	TITLE CLRIMP

;Program to clear away hanging IMP DDBs "cleanly" by changing the state
;to Time Wait and setting a timer.  This ensures that the DDBFls routine
;will be called and release all free storage pointed to by this DDB.

A←←1 ↔ B←←2 ↔ C←←3 ↔ DDB←←4 ↔ P←←17

ACWPRV←←40		;LH priv bit
PDLEN←←20
S%FIN2←←=7		;State we want to get out of
S%TIMW←←=9		;State we want to get into
IMPSRV←←1		;TTYLIN(DDB) flag for DDB awaiting erver

;IMP DDB words, with AC field set for indirect access
DEVNAM:	0(DDB)
DEVSER:	3(DDB)
STATE:	(DDB)			;To be filled in with .SYMLed value
GTIMER:	(DDB)			;To be filled in with .SYMLed value
TTYLIN:	(DDB)			;To be filled in with .SYMLed value

;Other storage
IMPDDB:	0			;Address of model IMP DDB
SYSTOP:	0			;Start of system free storage
SYSREL:	0			;Relocation for system core
DDBSAV:	0			;Address of current DDB
CONFRM:	0			;Whether to confirm each DDB
NUMBAD:	0			;Number of bad DDBs found
NUMCLR:	0			;Number cleared
PDL:	BLOCK PDLEN

CLRIMP:	RESET
	SETZM NUMBAD
	SETZM NUMCLR
	MOVE P,[IOWD PDLEN,PDL]
	MOVSI A,1
	GETPRV A,		;Get passive privs
	TLNN A,ACWPRV		;Can this guy write core?
	 JRST [ OUTSTR [ASCIZ/Sorry, only wizards can run this program./]
		EXIT]
	MOVSI A,ACWPRV
	SETPRV A,		;Enable
	MOVEI A,[RADIX50 0,IMPDDB ↔ 0]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for IMPDDB./]
		EXIT]
	MOVEM A,IMPDDB
	MOVEI A,[RADIX50 0,STATE ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for STATE./]
		EXIT]
	HRRM A,STATE
	MOVEI A,[RADIX50 0,GTIMER ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for GTIMER./]
		EXIT]
	HRRM A,GTIMER
	MOVEI A,[RADIX50 0,TTYLIN ↔ RADIX50 0,WAITS]
	.SYML A,
	 JRST [ OUTSTR [ASCIZ/.SYML failed for TTYLIN./]
		EXIT]
	HRRM A,TTYLIN
	MOVEI A,265
	PEEK A,			;Get SYSTOP
	PEEK A,
	TRZ A,1777		;Make sure it's a 1K boundary
	CAILE A,400000		;Not beyond 400000, though
	 MOVEI A,400000
	MOVEM A,SYSTOP
	MOVEI B,400000		;Compute relocation for later offsets
	SUB B,A
	MOVEM B,SYSREL
	MOVE B,A
	ADDI B,377776		;Get as much as possible, writeable
	HRL A,B
	SETPR2 A,		;Map system into upper segment
	 JRST [ OUTSTR [ASCIZ/SETPR2 lost./]
		EXIT]
	SETOM CONFRM		;Assume yes
	OUTSTR [ASCIZ/Do you want to confirm each DDB being cleared? /]
	PUSHJ P,YESNO
	SETZM CONFRM		;No

	MOVE A,IMPDDB
	ADD A,DEVSER
	HRRZ A,A
	PEEK A,
	HLRZ DDB,A		;Address of first IMP DDB
LOOP:	MOVEM DDB,DDBSAV	;Save before relocating
	ADD DDB,SYSREL		;Relocate to upper segment
	HLRZ A,@DEVNAM		;Get device name
	CAIE A,'IMP'		;Is it an IMP?
	 JRST ALLDON		;No
	MOVE A,@TTYLIN		;Get TTYLIN word from DDB
	TLNN A,IMPSRV		;Awaiting server?
	JRST LOOP1		;No
	MOVEI C,[ASCIZ/ awaiting server/]
	JRST BADDDB
LOOP1:	SKIPL A,@STATE		;Get connection's TCP state, skip if error
	JRST LOOP2
	MOVEI C,[ASCIZ/ in error state/]
	JRST BADDDB
LOOP2:	CAIE A,S%FIN2		;In the losing state?
	JRST NXTIMP		;No, move on to next DDB
	MOVEI C,[ASCIZ/ in state Fin2/]
BADDDB:	AOS NUMBAD		;Count them
	SKIPN CONFRM		;Does he want to confirm?
	 JRST CLRONE		;No
	OUTSTR [ASCIZ/IMP DDB at /]
	MOVE A,DDBSAV
	PUSHJ P,OCTOUT		;Clobbers A and B
	OUTSTR (C)		;Reason for DDB
	OUTSTR [ASCIZ/.  Clear it? /]
	PUSHJ P,YESNO
	 JRST NXTIMP		;No
CLRONE:	AOS NUMCLR		;Count number cleared
	MOVEI A,1		;Set timer
	MOVEM A,@GTIMER
	MOVEI A,S%TIMW		;Set new state
	MOVEM A,@STATE
NXTIMP:	HLRZ DDB,@DEVSER	;Get next DDB
	CAML DDB,SYSTOP		;Make sure it's in free storage
	 JRST LOOP
ALLDON:	MOVE A,NUMBAD
	PUSHJ P,DECOUT
	OUTSTR [ASCIZ/ bad DDBs found, /]
	MOVE A,NUMCLR
	PUSHJ P,DECOUT
	OUTSTR [ASCIZ/ cleared./]
	EXIT

OCTOUT:	IDIVI A,10
	PUSH P,B
	JUMPE A,OCTOU1
	PUSHJ P,OCTOUT
OCTOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

DECOUT:	IDIVI A,=10
	PUSH P,B
	JUMPE A,DECOU1
	PUSHJ P,DECOUT
DECOU1:	POP P,A
	ADDI A,"0"
	OUTCHR A
	POPJ P,

;Get Yes-or-no response; skip if Yes.
YESNO:	INCHRW A
	CAIN A,15		;<cr>?
	 JRST [ INCHRW A	;Yes, eat <lf>
		JRST YESNO2]
	CAIE A,"Y"
	CAIN A,"y"
	CAIA
	JRST YESNO1
	OUTSTR [ASCIZ/es.
/]
CPOPJ1:	AOS (P)
CPOPJ:	POPJ P,

YESNO1:	CAIE A,"N"
	CAIN A,"n"
	CAIA
	JRST YESNO2
	OUTSTR [ASCIZ/o.
/]
	POPJ P,

YESNO2:	OUTSTR [ASCIZ/
Please type Y or N: /]
	JRST YESNO

	END CLRIMP